home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbwp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  11.8 KB  |  332 lines
  1. (*===========================================================================*)
  2. (* Write WP info                                                             *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBWP;
  11.  
  12. INTERFACE
  13.  
  14.   FUNCTION wp_write : BOOLEAN;
  15.  
  16.   CONST
  17.     wp_write_file_name = 'WP.OUT';
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES
  22.   bbdummy,
  23.   bbmdata,
  24.   bbmess,
  25.   bbmisc5,
  26.   bbrunerr,
  27.   bbsdata,
  28.   bbsema2,
  29.   bbtask,
  30.   bbtime,
  31.   bbuf;
  32.  
  33. (*===========================================================================*)
  34. (* WP_WRITE                                                                  *)
  35. (*===========================================================================*)
  36.  
  37. FUNCTION wp_write : BOOLEAN;
  38.  
  39.   VAR
  40.     exp_date    : LONGINT;
  41.     first_one   : BOOLEAN;
  42.     i           : INTEGER;
  43.     loop_count  : BYTE;
  44.     op_tcb      : tcb_ptr;
  45.     uid_buffer  : user_record_type;
  46.     u_i_ptr     : user_index_ptr;
  47.     wp_file     : TEXT;
  48.  
  49.   PROCEDURE wp_start_write;
  50.     VAR
  51.       io_result  : INTEGER;
  52.       startup_sw : BOOLEAN;
  53.  
  54.     BEGIN;
  55.  
  56.       ASSIGN(wp_file, wp_write_file_name);
  57.  
  58.       {$I-}
  59.       APPEND(wp_file);
  60.       io_result := IORESULT;
  61.       {$I+}
  62.       startup_sw := io_result <> dos_ok;
  63.  
  64.       IF startup_sw THEN
  65.         BEGIN;
  66.  
  67.           {$I-}
  68.           REWRITE(wp_file);
  69.           io_result := IORESULT;
  70.           {$I+}
  71.  
  72.         END;
  73.  
  74.       IF io_result <> dos_ok THEN
  75.         BEGIN;
  76.           send_tnc_data_str(dos_err_message(i) + cr);
  77.           active_tcb^.error_sw := TRUE;
  78.           EXIT;
  79.         END;
  80.  
  81.       IF startup_sw THEN
  82.         BEGIN;
  83.           WRITELN(wp_file, 'SP WPAGE @ ', opt_block.wp_bb_sign);
  84.           WRITELN(wp_file, 'WP auto-update');
  85.         END;
  86.  
  87.     END;
  88.  
  89.   PROCEDURE wp_write_data(uid : user_record_ptr);
  90.     VAR
  91.       s : STRING;
  92.  
  93.     BEGIN;
  94.  
  95.       (*---------------------------------------------------------------------*)
  96.       (* Compute Home BBS.  Add "H" address if it is us                      *)
  97.       (*---------------------------------------------------------------------*)
  98.  
  99.       s := uid^.user_bbs;
  100.       IF (s = opt_block.this_bb_sign) OR (s = opt_block.this_bb_addr) THEN
  101.         s := s + opt_block.this_bb_h;
  102.  
  103.       (*---------------------------------------------------------------------*)
  104.       (* Put out various times                                               *)
  105.       (*---------------------------------------------------------------------*)
  106.  
  107.       s := s + ' On ' + COPY(time_str(uid^.user_n_time, TRUE), 1, 6)
  108.                           + ' Expires ' + COPY(time_str(exp_date, TRUE), 1, 6);
  109.  
  110.       (*---------------------------------------------------------------------*)
  111.       (* Name and Zip if they are here                                       *)
  112.       (*---------------------------------------------------------------------*)
  113.  
  114.       IF uid^.user_name <> '' THEN
  115.         s := s + ' Name ' + uid^.user_name;
  116.  
  117.       IF uid^.user_zip <> '' THEN
  118.         s := s + ' Zip ' + uid^.user_zip;
  119.  
  120.       (*---------------------------------------------------------------------*)
  121.       (* Write the line out                                                  *)
  122.       (*---------------------------------------------------------------------*)
  123.  
  124.       WRITELN(wp_file, uid^.user_id, ' QTH ', s);
  125.  
  126.     END;
  127.  
  128.   FUNCTION check_uid(uid : user_record_ptr) : BOOLEAN;
  129.  
  130.     BEGIN
  131.  
  132.       (*---------------------------------------------------------------------*)
  133.       (* Assume user not to be written                                       *)
  134.       (*---------------------------------------------------------------------*)
  135.  
  136.       check_uid := FALSE;
  137.  
  138.       (*---------------------------------------------------------------------*)
  139.       (* Must have a BBS                                                     *)
  140.       (*---------------------------------------------------------------------*)
  141.  
  142.       IF uid^.user_bbs = '' THEN EXIT;
  143.  
  144.       (*---------------------------------------------------------------------*)
  145.       (* Must have changed                                                   *)
  146.       (*---------------------------------------------------------------------*)
  147.  
  148.       IF (uid^.user_flag AND user_f_adrchg) = 0 THEN
  149.         EXIT;
  150.  
  151.       (*---------------------------------------------------------------------*)
  152.       (* Must have a current date                                            *)
  153.       (*---------------------------------------------------------------------*)
  154.  
  155.       exp_date := uid^.user_n_time + opt_block.home_expires;
  156.       IF exp_date < (current_day_time + 28) THEN
  157.         EXIT;
  158.  
  159.       (*---------------------------------------------------------------------*)
  160.       (* SUCCESS!!!                                                          *)
  161.       (*---------------------------------------------------------------------*)
  162.  
  163.       check_uid := TRUE;
  164.  
  165.     END;
  166.  
  167.   (*=========================================================================*)
  168.   (* Main line                                                               *)
  169.   (*=========================================================================*)
  170.  
  171.   BEGIN;
  172.  
  173.     wp_write := FALSE;
  174.  
  175.     (*-----------------------------------------------------------------------*)
  176.     (* If no place to send it, then leave                                    *)
  177.     (*-----------------------------------------------------------------------*)
  178.  
  179.     IF opt_block.wp_bb_sign = '' THEN
  180.       EXIT;
  181.  
  182.     (*-----------------------------------------------------------------------*)
  183.     (* Tell SYSOP what is happening                                          *)
  184.     (*-----------------------------------------------------------------------*)
  185.  
  186.     send_tnc_data_str('WP update message processing started' + cr);
  187.  
  188.     (*-----------------------------------------------------------------------*)
  189.     (* Find operator's TCB                                                   *)
  190.     (*-----------------------------------------------------------------------*)
  191.  
  192.     op_tcb := main_tcb^.next_tcb;
  193.  
  194.     WHILE (op_tcb^.tcb_type <> th_operator) AND (op_tcb <> main_tcb) DO
  195.       op_tcb := op_tcb^.next_tcb;
  196.  
  197.     IF op_tcb = main_tcb THEN
  198.       BEGIN;
  199.         WRITELN('*****');
  200.         WRITELN('WP processing could not find operator');
  201.         WRITELN('*****');
  202.         HALT;
  203.       END;
  204.  
  205.     (*-----------------------------------------------------------------------*)
  206.     (* Loop thru user records looking for WP work to do                      *)
  207.     (*-----------------------------------------------------------------------*)
  208.  
  209.     first_one  := TRUE;
  210.     loop_count := 20;
  211.  
  212.     u_i_ptr := uid_chain;
  213.  
  214.     WHILE u_i_ptr <> NIL DO
  215.       BEGIN;
  216.  
  217.         (*-------------------------------------------------------------------*)
  218.         (* Fetch the user                                                    *)
  219.         (*-------------------------------------------------------------------*)
  220.  
  221.         uid_buffer := get_uid(u_i_ptr)^;
  222.  
  223.         (*-------------------------------------------------------------------*)
  224.         (* See if this applies                                               *)
  225.         (*-------------------------------------------------------------------*)
  226.  
  227.         IF check_uid(@uid_buffer) THEN
  228.           BEGIN;
  229.  
  230.             (*---------------------------------------------------------------*)
  231.             (* Write this user out                                           *)
  232.             (*---------------------------------------------------------------*)
  233.  
  234.             (*---------------------------------------------------------------*)
  235.             (* Is this the first user to be written out.  If so, start things*)
  236.             (*---------------------------------------------------------------*)
  237.  
  238.             IF first_one THEN
  239.               BEGIN;
  240.                 wp_start_write;
  241.                 IF active_tcb^.error_sw THEN EXIT;
  242.                 first_one := FALSE;
  243.                 wp_write  := TRUE;
  244.               END;
  245.  
  246.             (*---------------------------------------------------------------*)
  247.             (* Tell SYSOP what is happening                                  *)
  248.             (*---------------------------------------------------------------*)
  249.  
  250.             send_tnc_data_str('WP update for ' + uid_buffer.user_id + cr);
  251.  
  252.             (*---------------------------------------------------------------*)
  253.             (* Write the data out                                            *)
  254.             (*---------------------------------------------------------------*)
  255.  
  256.             wp_write_data(@uid_buffer);
  257.             IF active_tcb^.error_sw THEN EXIT;
  258.  
  259.             (*---------------------------------------------------------------*)
  260.             (* Turn off the flag so we don't do this again.                  *)
  261.             (*---------------------------------------------------------------*)
  262.  
  263.             uid_buffer.user_flag :=
  264.                                   uid_buffer.user_flag AND (NOT user_f_adrchg);
  265.  
  266.             (*---------------------------------------------------------------*)
  267.             (* Write the user data back into the info file                   *)
  268.             (*---------------------------------------------------------------*)
  269.  
  270.             update_uid(@uid_buffer);
  271.  
  272.             (*---------------------------------------------------------------*)
  273.             (* Catch the special case of the local SYSOP                     *)
  274.             (*---------------------------------------------------------------*)
  275.  
  276.             IF uid_buffer.user_i_ptr = op_tcb^.uid_data.user_i_ptr THEN
  277.               op_tcb^.uid_data.user_flag :=
  278.                             op_tcb^.uid_data.user_flag AND (NOT user_f_adrchg);
  279.  
  280.           END; (*----- End handling a user to do ----------------------------*)
  281.  
  282.        u_i_ptr := u_i_ptr^.user_next;
  283.  
  284.        IF loop_count > 0 THEN
  285.          DEC(loop_count)
  286.        ELSE
  287.          BEGIN;
  288.            loop_count := 20;
  289.            task_switch;
  290.          END;
  291.  
  292.      END;
  293.  
  294.     (*-----------------------------------------------------------------------*)
  295.     (* If nothing happened then exit                                         *)
  296.     (*-----------------------------------------------------------------------*)
  297.  
  298.      IF first_one THEN
  299.        BEGIN;
  300.          send_message(message_action_complete);
  301.          EXIT;
  302.        END;
  303.  
  304.     (*-----------------------------------------------------------------------*)
  305.     (* Obtain the interrupt lock                                             *)
  306.     (*-----------------------------------------------------------------------*)
  307.  
  308.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  309.  
  310.     (*-----------------------------------------------------------------------*)
  311.     (* Close up                                                              *)
  312.     (*-----------------------------------------------------------------------*)
  313.  
  314.     CLOSE(wp_file);
  315.  
  316.     (*-----------------------------------------------------------------------*)
  317.     (* Release the interrupt lock                                            *)
  318.     (*-----------------------------------------------------------------------*)
  319.  
  320.     free_semaphore(semaphore_interrupts);
  321.  
  322.     (*-----------------------------------------------------------------------*)
  323.     (* Tell user                                                             *)
  324.     (*-----------------------------------------------------------------------*)
  325.  
  326.     send_message(message_action_complete);
  327.  
  328.   END;
  329.  
  330. END.
  331.  
  332.